//	COPYRIGHT (C) 1981 BY BOARD OF TRUSTEES,
//	LELAND STANFORD JUNIOR UNIVERSITY

/* SEPTEMBER '80, MODIFICATION TO CTE REPRESENTATION TO ALLOW ADDITIONAL
 COLOUR TAGS ON ATOMS.
*/
MANIFEST $( RHINF = RH&&PLUSINF $);
MANIFEST $( CTE.NUM = 2; CTE.ATS = #51; CTE.HR = #231; CTE.MARKS = #3131; CTE.COLOURS = #5131; 
            CTE.LR = #531; CTE.NBRS = 5 $);
MANIFEST $( NCTEWORDS = 9 $);
MANIFEST $( CONFIG1MARK = 8; CONFIG0MARK = 16;
	    SP3MARK=32; SP2MARK=64; SP1AMARK=128; SP1BMARK=256;
            NONARMARK = 4; ARMARK = 2; TAGMARK = 1 $);

MANIFEST $( RED = 1; ORANGE = 2; YELLOW = 4; GREEN = 8;
            BLUE = 16; VIOLET = 32; WHITE = 64; BLACK = 128;
            GOLD = 256; SILVER = 512
	    PUCE = 1024; POLDADOT = 2048
	    RAINBOW = #7777
         $)


LET MAKECTE(CTENUM) = VALOF
 $( LET CTE=CREATE(CTE.NUM,CTE.ATS,CTE.HR,CTE.MARKS,CTE.COLOURS,CTE.LR,CTE.NBRS);
 REPLACE(CTE.NUM,CTE,CTENUM);
 REPLACE(CTE.ATS,CTE,CONS(NUMOFSTR("C"),@NULL));
 REPLACE(CTE.HR,CTE,CONS(1,0));
 REPLACE(CTE.LR,CTE,CONS(1,0));
 REPLACE(CTE.MARKS,CTE,0);
 REPLACE(CTE.COLOURS,CTE,0);
 RESULTIS CTE
 $);

LET UNMAKECTE(CTE) BE
 $(
 UNCONS(FETCH(CTE.HR,CTE));
 UNCONS(FETCH(CTE.LR,CTE));
 UNLIST(FETCH(CTE.ATS,CTE));
 UNLIST(FETCH(CTE.NBRS,CTE));
 UNCREATE(CTE,CTE.NUM,CTE.ATS,CTE.HR,CTE.MARKS,CTE.COLOURS,CTE.LR,CTE.NBRS)
 $);

LET CLEAR() BE
 $(
 MAPC(CTELIST,UNMAKECTE);
 UNLIST(CTELIST);
 CTELIST:=@NULL;
 MAPC(ANYBONDS,UNCONS);
 UNLIST(ANYBONDS);
 ANYBONDS:=@NULL
 $);

LET POLYP(CTE) = CDR(FETCH(CTE.ATS,CTE)) NE @NULL;

LET LNP(CTE) = NOT[0=CDR(FETCH(CTE.LR,CTE))];

LET HRP(CTE) = VALOF
 $(
 CTE:=FETCH(CTE.HR,CTE);
 RESULTIS CAR(CTE) LE CDR(CTE)
 $);

LET TESTCOLOUR(CTE,COLOUR) = [COLOUR = [COLOUR BITAND FETCH(CTE.COLOURS,CTE)]]

LET TESTMARK(CTE,MARK) = [MARK = [MARK BITAND FETCH(CTE.MARKS,CTE)]];

LET TAGP(CTE) = TESTMARK(CTE,TAGMARK);

LET ARP(CTE) = TESTMARK(CTE,ARMARK);

LET NONARP(CTE) = TESTMARK(CTE,NONARMARK);

LET CONF1P(CTE) = TESTMARK(CTE,CONFIG1MARK);

LET CONF0P(CTE) = TESTMARK(CTE,CONFIG0MARK);

LET SP3P(CTE) = TESTMARK(CTE,SP3MARK);

LET SP2P(CTE) = TESTMARK(CTE,SP2MARK);

LET SP1AP(CTE) = TESTMARK(CTE,SP1AMARK);

LET SP1BP(CTE) = TESTMARK(CTE,SP1BMARK);

LET HYBRIDSPECP(CTE)=
  (TESTMARK(CTE,SP3MARK)->TRUE,
    (TESTMARK(CTE,SP2MARK)->TRUE,
     (TESTMARK(CTE,SP1AMARK)->TRUE, TESTMARK(CTE,SP1BMARK))));


LET ARSPECP(CTE) =
 (TESTMARK(CTE,ARMARK) -> TRUE,TESTMARK(CTE,NONARMARK));

LET CONFIGSPEC(CTE) =
 (TESTMARK(CTE,CONFIG0MARK) -> TRUE, TESTMARK(CTE,CONFIG1MARK));

LET ANYBENTRY(I,J) = VALOF
 $( STATIC $( NI = NIL; NJ = NIL $);

 LET IJEQ(ABE) = (NI=CAR(ABE) -> [NJ=CDR(ABE)],FALSE);

 IF ANYBONDS=@NULL DO RESULTIS @NULL;
 TEST I>J THEN $( NI:=I; NJ:=J $) OR $( NI:=J; NJ:=I $);
 RESULTIS CAR(SOME(ANYBONDS,IJEQ))
 $);


LET COLOURP(CTE) = valof
  $( STATIC $( COLOURS = NIL $)
   COLOURS:=FETCH(CTE.COLOURS,CTE)
   if COLOURS=0 then resultis FALSE
   if COLOURS=RAINBOW then resultis FALSE
   resultis TRUE
  $)
 
